home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / pbc_bas.exe / DCAL.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-01-01  |  5.5 KB  |  157 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE SUB CalcAttr (BYVAL Foreground%, BYVAL Background%, VAttr%)
  8.    DECLARE SUB DateA2R (BYVAL MonthNr%, BYVAL DayNr%, BYVAL YearNr%, RelDate&)
  9.    DECLARE SUB DateR2A (MonthNr%, DayNr%, YearNr%, RelDate&)
  10.    DECLARE SUB DXQPrint (BYVAL DSeg%, BYVAL DOfs%, St$, BYVAL Row%, BYVAL Column%, BYVAL VAttr%)
  11.    DECLARE SUB Month0 (MonthName$, NameLen%, MonthNumber%)
  12.  
  13. SUB DCal (Scrn%(), CalDate$)
  14.    CalcAttr 5, 0, FrameAttr%           ' outer frame
  15.    CalcAttr 5, 1, GridAttr%            ' grid
  16.    CalcAttr 11, 5, MonthNameAttr%      ' month and year
  17.    CalcAttr 1, 7, DayNameAttr%         ' days of the week
  18.    CalcAttr 5, 1, EdgeDayAttr%         ' days in previous and next months
  19.    CalcAttr 15, 1, WeekdayAttr%        ' weekdays
  20.    CalcAttr 7, 1, WeekendAttr%         ' weekends
  21.    CalcAttr 14, 1, TodayAttr%          ' today, if showing current month
  22.  
  23.    L% = LBOUND(Scrn%)
  24.  
  25. ' --------------- draw the outer frame ----------------------------------------
  26.  
  27.    St$ = "┌──────────────────────────────────┐"
  28.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 5, 43, FrameAttr%
  29.    St$ = "├──────────────────────────────────┤"
  30.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 8, 43, FrameAttr%
  31.    St$ = "└──────────────────────────────────┘"
  32.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 22, 43, FrameAttr%
  33.    Row% = 6
  34.    St$ = "│                                  │"
  35.    DO
  36.       DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row%, 43, FrameAttr%
  37.       IF Row% = 7 THEN
  38.          Row% = 9
  39.       ELSE
  40.          Row% = Row% + 1
  41.       END IF
  42.    LOOP UNTIL Row% > 21
  43.  
  44. ' --------------- fill in the header info -------------------------------------
  45.  
  46.    IF LEN(CalDate$) >= 8 THEN
  47.       MonthNr% = VAL(CalDate$)
  48.       YearNr% = VAL(MID$(CalDate$, 7))
  49.    ELSE
  50.       St$ = DATE$
  51.       MonthNr% = VAL(St$)
  52.       YearNr% = VAL(MID$(St$, 7))
  53.    END IF
  54.  
  55.    IF YearNr% < 100 THEN YearNr% = YearNr% + 1900
  56.  
  57.    IF MonthNr% = CINT(VAL(DATE$)) AND YearNr% = CINT(VAL(MID$(DATE$, 7))) THEN
  58.       CurrentMonth% = -1
  59.       Today% = CINT(VAL(MID$(DATE$, 4)))
  60.    END IF
  61.  
  62.    MonthName$ = SPACE$(9)
  63.    Month0 MonthName$, MLen%, MonthNr%
  64.    MonthName$ = LEFT$(MonthName$, MLen%)
  65.    St$ = SPACE$(34)
  66.    MID$(St$, 17 - (LEN(MonthName$) + 6) \ 2) = MonthName$ + STR$(YearNr%)
  67.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 6, 44, MonthNameAttr%
  68.  
  69.    St$ = " Su   Mo   Tu   We   Th   Fr   Sa "
  70.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 7, 44, DayNameAttr%
  71.  
  72. ' --------------- draw the grid -----------------------------------------------
  73.  
  74.    St$ = "────┬────┬────┬────┬────┬────┬────"
  75.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 9, 44, GridAttr%
  76.    FOR Row% = 10 TO 18 STEP 2
  77.       St$ = "    │    │    │    │    │    │    "
  78.       DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row%, 44, GridAttr%
  79.       St$ = "────┼────┼────┼────┼────┼────┼────"
  80.       DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row% + 1, 44, GridAttr%
  81.    NEXT
  82.    St$ = "    │    │    │    │    │    │    "
  83.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 20, 44, GridAttr%
  84.    St$ = "────┴────┴────┴────┴────┴────┴────"
  85.    DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, 21, 44, GridAttr%
  86.  
  87. ' --------------- calculate necessary info ------------------------------------
  88.  
  89.    DateA2R MonthNr%, 1, YearNr%, RelDate&
  90.    IF MonthNr% = 12 THEN
  91.       DateA2R 1, 1, YearNr% + 1, NextDate&
  92.    ELSE
  93.       DateA2R MonthNr% + 1, 1, YearNr%, NextDate&
  94.    END IF
  95.    DaysInMonth% = NextDate& - RelDate&
  96.    DateR2A M%, DaysLastMonth%, Y%, RelDate& - 1&
  97.  
  98. ' --------------- do the calendar ---------------------------------------------
  99.  
  100.    WDay% = 0
  101.    DayNr% = DaysLastMonth% - RelDate& MOD 7& + 1
  102.    R% = 0: C% = 0
  103.    WHILE DayNr% <= DaysLastMonth%
  104.       St$ = RIGHT$(" " + STR$(DayNr%), 3) + " "
  105.       Row% = R% * 2 + 10
  106.       Col% = C% * 5 + 44
  107.       DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row%, Col%, EdgeDayAttr%
  108.       DayNr% = DayNr% + 1
  109.       WDay% = (WDay% + 1) MOD 7
  110.       IF WDay% THEN
  111.          C% = C% + 1
  112.       ELSE
  113.          R% = R% + 1
  114.          C% = 0
  115.       END IF
  116.    WEND
  117.  
  118.    DayNr% = 1
  119.    WHILE DayNr% <= DaysInMonth%
  120.       St$ = RIGHT$(" " + STR$(DayNr%), 3) + " "
  121.       Row% = R% * 2 + 10
  122.       Col% = C% * 5 + 44
  123.       IF CurrentMonth% AND (DayNr% = Today%) THEN
  124.          VAttr% = TodayAttr%
  125.       ELSEIF WDay% = 0 OR WDay% = 6 THEN
  126.          VAttr% = WeekendAttr%
  127.       ELSE
  128.          VAttr% = WeekdayAttr%
  129.       END IF
  130.       DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row%, Col%, VAttr%
  131.       DayNr% = DayNr% + 1
  132.       WDay% = (WDay% + 1) MOD 7
  133.       IF WDay% THEN
  134.          C% = C% + 1
  135.       ELSE
  136.          R% = R% + 1
  137.          C% = 0
  138.       END IF
  139.    WEND
  140.  
  141.    DayNr% = 1
  142.    WHILE R% <= 5 AND C% <= 6
  143.       St$ = RIGHT$(" " + STR$(DayNr%), 3) + " "
  144.       Row% = R% * 2 + 10
  145.       Col% = C% * 5 + 44
  146.       DXQPrint VARSEG(Scrn%(L%)), VARPTR(Scrn%(L%)), St$, Row%, Col%, EdgeDayAttr%
  147.       DayNr% = DayNr% + 1
  148.       WDay% = (WDay% + 1) MOD 7
  149.       IF WDay% THEN
  150.          C% = C% + 1
  151.       ELSE
  152.          R% = R% + 1
  153.          C% = 0
  154.       END IF
  155.    WEND
  156. END SUB
  157.